home *** CD-ROM | disk | FTP | other *** search
/ Aminet 24 / Aminet 24 (1998)(GTI - Schatztruhe)[!][Apr 1998].iso / Aminet / comm / thor / DLManager.lha / DLManager.thor < prev   
Encoding:
Text File  |  1998-01-03  |  13.2 KB  |  627 lines
  1. /*
  2. **   $Filename: DLManager.thor
  3. **
  4. **   $VER: DLManager v1.5 ©1996-1998
  5. **
  6. **   Copyright 1996-1998, Troy E. Bouchard.
  7. **
  8. **   Author: Troy E. Bouchard
  9. **   E-Mail: tbouchar@ptialaska.net
  10. **
  11. **   Library Files needed:
  12. **         bbsread.library (of course)
  13. **         rexxarplib.library (get it from Aminet!)
  14. **         rexxsupport.library (get it from Aminet!)
  15. **
  16. */
  17.  
  18. SIGNAL ON SYNTAX
  19. SIGNAL ON HALT
  20.  
  21. EVE_ENTERMSG = 0
  22.  
  23. /* Find our Thor Port and number! */
  24. p = Address() || ' ' || show('P',,)
  25.     ThorPort = pos('THOR.',p)
  26.  
  27.     if ThorPort > 0 then ThorPort = word(substr(p,ThorPort),1)
  28. else
  29.     do
  30.     say "Can't seem to find the Thor port!"
  31.     exit 10
  32.     End
  33.  
  34. /* Load the BBSRead library up! */
  35. if ~show('p', 'BBSREAD') then
  36. do
  37.    address command
  38.       "run >nil: `GetEnv THOR/THORPath`bin/LoadBBSRead"
  39.      "WaitForPort BBSREAD"
  40. End
  41.  
  42. if ~Show('L','rexxarplib.library') then
  43. do
  44.    if ~AddLib('rexxarplib.library',0,-30,0) then
  45.    do
  46.       Address(ThorPort)
  47.       'REQUESTNOTIFY TEXT '"Couldn't open rexxarplib.library"' BT "_Exiting!"'
  48.       exit 5
  49.    end
  50. end
  51.  
  52. if ~Show('L','rexxsupport.library') then
  53. do
  54.    if ~AddLib('rexxsupport.library',0,-30,0) then
  55.    do
  56.       Address(ThorPort)
  57.       'REQUESTNOTIFY TEXT '"Couldn't open rexxsupport.library"' BT "_Exiting!"'
  58.       exit 5
  59.    end
  60. end
  61.  
  62. options results
  63.  
  64.    MyPort = OpenPort(DLPORT)
  65.    if MyPort = 0 then
  66.    do
  67.       Address(ThorPort)
  68.       'REQUESTNOTIFY TEXT '"Couldn't open the port"' BT "_Exiting!"'
  69.       exit 5
  70.    end
  71.  
  72.    address AREXX ,
  73.      "'Call CreateHost(DLHOST,DLPORT)'"
  74.  
  75.    do i = 1 to 10
  76.       if ~Showlist('P',DLHOST) then call delay 50
  77.       else leave i
  78.    end
  79.  
  80.    if i = 10 & ~Showlist('P',DLHOST) then
  81.    do
  82.       Address(ThorPort)
  83.       'REQUESTNOTIFY TEXT '"Couldn't open the Host"' BT "_Exiting!"'
  84.       exit 5
  85.    end
  86.  
  87.    Call CreateWIN()
  88.  
  89. WaitStuff:
  90.    fini = 0
  91.  
  92.    do forever
  93.       if fini = 1 then leave
  94.       t = waitpkt(DLPORT)
  95.       do i = 1
  96.      p = getpkt(DLPORT)
  97.      if c2d(p) = 0 then leave i
  98.      cmd = getarg(p)
  99.      j = reply(p,0)
  100.      Select
  101.         When cmd = CLOSEWINDOW then do
  102.            Call Quit()
  103.         end
  104.         When cmd = GETSYSTEM then do
  105.            Call GetSystem()
  106.            win.txt = 'Current System: 'TB_SYSTEM
  107.            Call WindowText(DLHOST, win.txt)
  108.         end
  109.         When cmd = NEWLIST then do
  110.            Call NewList()
  111.         end
  112.         When cmd = WRITEMSG then do
  113.            Call WriteMSG()
  114.         end
  115.         When cmd = DELLIST then do
  116.            Call DeleteList
  117.         end
  118.         When cmd = QUIT then do
  119.            Call Quit()
  120.         end
  121.         When cmd = ABOUT then do
  122.            Call About
  123.         end
  124.         When cmd = EDIT then do
  125.            Call Edit
  126.         end
  127.         When cmd = DELETEU then do
  128.            Call LeaveAlone()
  129.         end
  130.         otherwise nop
  131.      end
  132.       end
  133.    end
  134. Return
  135.  
  136. CreateWIN:
  137.    voffseta=0
  138.    voffsetb=0
  139.    gad. = ""
  140.    gad.0 = 28
  141.  
  142.    win.idcmp = "+CLOSEWINDOW+GADGETUP"
  143.    win.flags = "+WINDOWCLOSE+WINDOWDEPTH+BACKFILL+ACTIVATE"
  144.    win.title = "DLManager v1.5"
  145.  
  146.    gad.1.x = 30
  147.    gad.1.y = 38+voffseta
  148.    gad.1.name = "GETSYSTEM"
  149.    gad.1.text = " Get System "
  150.    gad.1.reportstring = "%d"
  151.  
  152.    gad.2.x = 30
  153.    gad.2.y = 56+voffseta
  154.    gad.2.name = "NEWLIST"
  155.    gad.2.text = "New/Add List"
  156.    gad.2.reportstring = "%d"
  157.  
  158.    gad.3.x = 156
  159.    gad.3.y = 38+voffseta
  160.    gad.3.name = "WRITEMSG"
  161.    gad.3.text = " Write Mesg "
  162.    gad.3.reportstring = "%d"
  163.  
  164.    gad.4.x = 156
  165.    gad.4.y = 56+voffseta
  166.    gad.4.name = "DELLIST"
  167.    gad.4.text = " Delete List"
  168.    gad.4.reportstring = "%d"
  169.  
  170.    gad.5.x = 30
  171.    gad.5.y = 74+voffseta
  172.    gad.5.name = "QUIT"
  173.    gad.5.text = "    Quit    "
  174.    gad.5.reportstring = "%d"
  175.  
  176.    gad.6.x = 156
  177.    gad.6.y = 74+voffseta
  178.    gad.6.name = "ABOUT"
  179.    gad.6.text = "    About   "
  180.    gad.6.reportstring = "%d"
  181.  
  182.    gad.7.x = 30
  183.    gad.7.y = 92+voffseta
  184.    gad.7.name = "EDIT"
  185.    gad.7.text = "    Edit    "
  186.    gad.7.reportstring = "%d"
  187.  
  188.    gad.8.x = 156
  189.    gad.8.y = 92+voffseta
  190.    gad.8.name = "DELETEU"
  191.    gad.8.text = " Delete User"
  192.    gad.8.reportstring = "%d"
  193.  
  194.    call SetReqColor(DLHOST,BACKGROUND,4) /* Color the Background */
  195.  
  196. /* Open the window and set the gadgets! */
  197.    call OpenWindow(DLHOST, 0, 0, 285, 112, win.idcmp, win.flags, win.title)
  198.  
  199.    window.text = '   Current System: ~None~'
  200.    Call WindowText(DLHOST, window.text)
  201.  
  202.    CNT = 0
  203.  
  204.    do n = 1 to gad.CNT
  205.       if gad.n.length = "" then
  206.      call Addgadget(DLHOST, gad.n.x, gad.n.y, ,
  207.         gad.n.name, gad.n.text, gad.n.reportstring)
  208.       else
  209.      call Addgadget(DLHOST, gad.n.x, gad.n.y, ,
  210.         gad.n.name, gad.n.text, gad.n.reportstring, ,
  211.            gad.n.length)
  212.    end
  213.  
  214. /* Color the Gadgets and activate em! (set activate -> ON
  215.    Call SetGadget(DLHOST, GETSYSTEM, ON)
  216.    Call SetGadget(DLHOST, NEWLIST,   ON)
  217.    Call SetGadget(DLHOST, WRITEMSG,  ON)
  218.    Call SetGadget(DLHOST, DELLIST,   ON)
  219.    Call SetGadget(DLHOST, QUIT,      ON)
  220.    Call SetGadget(DLHOST, ABOUT,     ON)
  221.    Call SetGadget(DLHOST, EDIT,      ON) */
  222. Return
  223.  
  224.  
  225. AddTDL:
  226.    Call GetSystemPath()
  227.  
  228.    Address(ThorPort)
  229.    'RequestFile Title "Select the .tdl file" ID "'DataPath'".tdl FP PAT "#?.tdl"'
  230.    if(rc = 5) then
  231.    do
  232.       'RequestNotify Text "Request Aborted!" BT "_Wow!"'
  233.       Call WaitStuff
  234.    end
  235.  
  236.    choice = result
  237.  
  238.    if ~Exists(choice) then
  239.    do
  240.       Call Open out, choice, 'w'
  241.       Call Close out
  242.    end
  243. Return(Choice)
  244.  
  245. NewList:
  246.    Call AddTDL
  247.    Call AutoManAdd
  248. Return
  249.  
  250. WriteCC:
  251.    Address BBSRead
  252.    'BufMode CopyBack'
  253.    CCAddrStr = ''
  254.    hdr = 'Cc: '
  255.    WAddressStr = hdr||ADDR.i
  256.    i=i+1
  257.    Do j = i to ADDR.COUNT
  258.       Interpret 'NextAddress = ADDR.'j
  259.       if Length(WAddressStr','NextAddress) > 246 then
  260.       do
  261.      CCAddrStr = CCAddrStr||WAddressStr||','||'0a'x
  262.      WAddressStr = ''
  263.       End
  264.       else WAddressStr = WAddressStr','
  265.       WAddressStr = WAddressStr||NextAddress
  266.    End
  267.  
  268.    if WAddressStr > '' then CCAddrStr = CCAddrStr||WAddressStr||'0a'x
  269.  
  270.    TmpFile = 'T:TDL.tmp'
  271.    Call Open out, TmpFile, 'W'
  272.    Call WriteLN out, CCAddrStr
  273.    Call Close out
  274.  
  275.    TmpOpen = Open(out, TmpFile, 'R')
  276.    if (TmpOpen) then do
  277.       TmpLen = Seek(out,0,'E')
  278.       Call Seek(out,0,'B')
  279.       nroflines = 0
  280.       do until (Seek(out,0)=TmpLen)
  281.      HdrLine = ReadLN(out)
  282.      Call Open in, DataPath||EVENT.MSGFILE, 'A'
  283.      Call WriteLN in, HdrLine
  284.      Call Close in
  285.      nroflines = nroflines + 1
  286.    end
  287.    Call Close out
  288.  
  289.    Address Command 'Delete >NIL: 'TmpFile
  290.    'BufMode EndCopyBack'
  291. Return
  292.  
  293. WriteMSG:
  294.    Call GetSig()      /* get the pathway to the sig file */
  295.    Call AddTDL()      /* get the distribution list         */
  296.    Call GetSystemPath()   /* get the pathway for the system  */
  297.  
  298.    Drop EVENT. /* make sure you free up the event */
  299.    Drop Addr.  /* make sure you free up the event */
  300.  
  301.    address(BBSREAD)
  302.    'UNIQUEMSGFILE bbsname "'TB_SYSTEM'" stem "'TDLFILE'"'
  303.    if(rc ~= 0) then
  304.    do
  305.       Address(ThorPort)
  306.       'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
  307.       Return
  308.    end
  309.  
  310.    EVENT.CONFERENCE = 'EMail'
  311.    EVENT.MSGFILE    = TDLFILE.FILEPART
  312.  
  313.    Call Open out, Choice, 'R'
  314.  
  315.    n = 0
  316.    do while ~eof(out)
  317.       Address = readln(out)
  318.       if Address = '' then leave
  319.       n = n+1
  320.       Interpret 'ADDR.'n' = Address'
  321.    end
  322.  
  323.    ADDR.COUNT = n
  324.    call Close(out)
  325.  
  326.    do i=1 to ADDR.COUNT
  327.       Interpret 'ADDR.'i'= GetListAddr(ADDR.'i')'
  328.    End
  329.  
  330.    Interpret 'EVENT.TONAME = GetListName(Choice)'
  331.  
  332.    AddressStr = ADDR.1
  333.    Do i = 2 to ADDR.COUNT
  334.       Interpret 'NextAddress = ADDR.'i
  335.       if Length(AddressStr','NextAddress) > 246 then
  336.       do
  337.      EVENT.TOADDR = AddressStr
  338.      Call WriteCC ; leave
  339.       End
  340.       else AddressStr = AddressStr','
  341.       AddressStr = AddressStr||NextAddress
  342.    End
  343.  
  344.    EVENT.TOADDR = AddressStr
  345.  
  346. /* Append the Sig file to the message. */
  347.    SigOpen = Open(out, SigFile, 'R')
  348.    if (SigOpen) then do
  349.       SigLen = Seek(out,0,'E')
  350.       Call Seek(out,0,'B')
  351.       nroflines = 0
  352.       do until (Seek(out,0)=SigLen)
  353.      Sig = ReadLN(out)
  354.      Call Open SigOut, TDLFILE.NAME, 'A'
  355.      Call WriteLN SigOut, Sig
  356.      Call Close SigOut
  357.      nroflines = nroflines + 1
  358.    end
  359.    Call Close out
  360.  
  361.    Address(ThorPort)
  362.    'REQUESTSTRING TITLE "Please enter your subject:" BT "_Ok|_Cancel" ID "DLManager v1.5" MAXCHARS 100'
  363.    EVENT.SUBJECT = result
  364.    if( rc ~= 0 | EVENT.SUBJECT = '') then
  365.       EVENT.SUBJECT = '(No Subject)' /* You always have to have a subject! */
  366.  
  367.    'StartEditor 'DataPath||EVENT.MSGFILE  /* Start whatever configured editor you are using */
  368.  
  369.    Address BBSREAD
  370.    'WRITEBREVENT bbsname "'TB_SYSTEM'" event 'EVE_ENTERMSG' stem 'EVENT''
  371.    if(rc ~= 0) then
  372.    do
  373.       Address(ThorPort)
  374.       'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
  375.      Call Close(fh) /* insanity check! */
  376.       Return
  377.    end
  378. Return
  379.  
  380. DeleteList:
  381.    Address(ThorPort)
  382.  
  383.    Call GetSystemPath()
  384.  
  385.    'RequestFile Title "Select the .tdl file to delete" ID "'DataPath'" FP PAT "#?.tdl"'
  386.    if(rc = 5) then
  387.    do
  388.       'RequestNotify Text "File Delete Aborted!" BT "_Whew!"'
  389.       Return
  390.    end
  391.  
  392.    Address Command 'Run <>NIL: Delete 'result
  393.    'RequestNotify Text "File Deleted!" BT "_I Know!"'
  394. Return
  395.  
  396. Quit:
  397.    Address(ThorPort)
  398.    'RequestNotify Text "Do you really\nwant to quit?" BT "_Yes|_No!"'
  399.    if(rc ~= 0) then
  400.    do
  401.       'RequestNotify Text "'THOR.LASTERROR'" BT "_OK"'
  402.       Call Cleanup
  403.    end
  404.  
  405.    if ( result = 0 ) then Call WaitStuff
  406.    if ( result = 1 ) then Call Cleanup
  407. Return
  408.  
  409. SYNTAX:
  410.    SAY 'SYNTAX ERROR'
  411.    SAY 'Error 'rc' in line 'sigl': 'errortext(rc)
  412. HALT:
  413. Cleanup:
  414.    Call CloseWindow(DLHOST)
  415.    fini = 1
  416.    Exit
  417.  
  418. GetListName: procedure
  419.          parse arg name
  420.  
  421.    psn = Lastpos('/', name)
  422.    psn = psn+1
  423.    listname = substr(name, psn)
  424.  
  425.    len = Length(listname)
  426.  
  427.    posn = len-4
  428.    lname = left(listname, posn)
  429. Return(lname)
  430.  
  431. GetListAddr: procedure
  432.          parse arg addr
  433.  
  434.    pesn = Lastpos(' ', addr)
  435.    pesn = pesn+1
  436.    listaddr = substr(addr, pesn)
  437.  
  438.    lent = Length(listaddr)
  439.  
  440.    laddr = left(listaddr, lent)
  441. Return(laddr)
  442.  
  443. AutoManAdd:
  444.    Address(ThorPort)
  445.    'RequestNotify Text "    Do you want to\n    Manually add or\nAdd from User Database?" BT "_Manually|_Add from UDB"'
  446.    if(rc ~= 0) then
  447.    do
  448.       'RequestNotify Text "'THOR.LASTERROR'" BT "_OK"'
  449.       Call Cleanup
  450.    end
  451.  
  452.    if ( result = 0 ) then call AddUDB
  453.    if ( result = 1 ) then Call AddMan
  454. return
  455.  
  456. AddUDB:
  457.    Address BBSREAD
  458.    Call GetSystemPath()
  459.  
  460.    'SearchBRUser BBSNAME "'TB_SYSTEM'" Stem "'SResult'" Search "#?" Name Address'
  461.    if(rc ~= 0) then
  462.    Do
  463.       Address(ThorPort)
  464.       'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
  465.       Call Cleanup
  466.    End
  467.  
  468.    if(result > 0) then
  469.    Do
  470.        Address BBSREAD
  471.  
  472.        drop LIST.
  473.        drop USERTAGS.
  474.  
  475.        LIST.COUNT = SResult.COUNT
  476.  
  477.        Do j=1 to SResult.COUNT
  478.       LIST.j.USERNR = SResult.j.USERNR
  479.       'READBRUSER BBSNAME "'TB_SYSTEM'" UserNR "'SResult.j.USERNR'" TagsStem "'USERTAGS'"'
  480.       if(rc ~= 0) then
  481.       Do
  482.          Address(ThorPort)
  483.          'RequestNotify Text "'BBSREAD.LASTERROR'" BT "_OK"'
  484.          Return
  485.       End
  486.         LIST.j = USERTAGS.ADDRESS
  487.        End
  488.  
  489.        Address(ThorPort)
  490.        'REQUESTLIST instem "'LIST'" outstem "'USEL'" Title "Get User:" MultiSelect'
  491.        if(rc ~= 0) then
  492.        Do
  493.       'RequestNotify Text "Command Cancelled" BT "_OK"'
  494.       Return
  495.        End
  496.    End
  497.  
  498.    if ~Exists(Choice) then
  499.       Call Open out, Choice, 'W'
  500.       Call Close out
  501.  
  502.    Call Open Out, Choice, 'A'
  503.  
  504.    Do k = 1 to USEL.COUNT
  505.       Call WriteLN out, USEL.k
  506.    End
  507.    Call Close out
  508. Return
  509.  
  510. AddMan:
  511.    Address(ThorPort)
  512.    Call GetSystemPath()
  513.    'RequestString TITLE "Enter E-Mail Address:" BT "_OK|_Cancel" ID "tbouchar@ptialaska.net"'
  514.    if(rc ~= 0) then
  515.    do
  516.       'RequestNotify TEXT "Command Canceled!" BT "_I Know!"'
  517.       return
  518.    end
  519.  
  520.    email = result
  521.  
  522.    if ~Exists(Choice) then
  523.    do
  524.       Call Open out, Choice, 'W'
  525.       Call WriteLN out, email
  526.       Call Close out
  527.    end
  528.    else
  529.    Call Open out, Choice, 'A'
  530.    Call WriteLN out, email
  531.    Call Close out
  532. Return
  533.  
  534. About:
  535.    Address(ThorPort)
  536.    'RequestNotify TEXT "Distribution List Manager v1.5\n     by Troy E. Bouchard\n EMail: tbouchar@ptialaska.net" BT "Thanks!"'
  537. return
  538.  
  539. Edit:
  540.    Call AddTDL
  541.    Address(ThorPort)
  542.  
  543.    'StartEditor 'Choice
  544. return
  545.  
  546. GetSystemPath:
  547.    Address BBSREAD
  548.    'GetBBSData "'TB_SYSTEM'" STEM "'GC'"'
  549.    DataPath = GC.BBSPATH
  550. Return(DataPath)
  551.  
  552. GetSig:
  553.    Call GetSystemPath()
  554.    Address BBSREAD
  555.    'GetBBSData "'TB_SYSTEM'" STEM "'BD'"'
  556.    SigFile = BD.SIGNATURE
  557. Return(SigFile)
  558.  
  559. GetSystem:
  560.    Address BBSREAD
  561.    'GETBBSLIST stem "'BBSLIST'"'
  562.    if(rc ~= 0) then
  563.    do
  564.     address(thorport)
  565.     'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_Ok"'
  566.     Call Cleanup
  567.    end
  568.  
  569.    Address(ThorPort)
  570.    'REQUESTLIST instem "'BBSLIST'" title "Select System:" SizeGadget'
  571.    if(rc ~= 0) then
  572.    do
  573.       Call WindowText(DLHOST, "'THOR.LASTERROR'")
  574.       Return
  575.    end
  576.  
  577.    TB_SYSTEM = result
  578. Return(TB_SYSTEM)
  579.  
  580. LeaveAlone:
  581.    Call AddTDL()
  582.  
  583.    Drop LIST.
  584.  
  585.    Call Open out, Choice, 'R'
  586.  
  587.    m = 0
  588.    do while ~eof(out)
  589.       ListName = readln(out)
  590.       if ListName = '' then leave
  591.       m = m+1
  592.       Interpret 'LIST.'m' = ListName'
  593.    end
  594.  
  595.    LIST.COUNT = m
  596.    call Close(out)
  597.  
  598.    Drop SELECTED.
  599.    SELECTED.COUNT = 0
  600.  
  601.    Address(ThorPort)
  602.    'REQUESTLIST Instem LIST Outstem SELECTED Title "Select User(s) to Delete" MultiSelect'
  603.    if rc = 5 then Return
  604.    if rc > 0 then
  605.    Do
  606.       'RequestNotify Text "'THOR.LASTERROR'" BT "OK"'
  607.       Call Cleanup
  608.    end
  609.  
  610.    TmpFile = 'T:del.tmp'
  611.  
  612.    Call Open out, TmpFile, 'W'
  613.    Call Close out
  614.  
  615.    do j=1 to LIST.COUNT
  616.       if SELECTED.1 ~= LIST.j then
  617.       do
  618.      Call Open out, TmpFile, 'A'
  619.      Call WriteLN out, LIST.j
  620.      Call Close out
  621.       end
  622.    end
  623.  
  624.    Address Command 'Copy >NIL: 'TmpFile Choice
  625.    Address Command 'Delete >NIL: 'TmpFile
  626. Return
  627.